#Subsample of metrics from MHSDS data
CAMHS_data <- MHSDS_main_pooled_dashboard %>%
  filter(PRIMARY_LEVEL_DESCRIPTION=="England",
         MEASURE_ID %in% c("CYP01","MHS61a","CYP23","MHS30d","MHS32a")) %>%
  filter(.,!(MEASURE_ID=="MHS32a"&BREAKDOWN!="England")) %>% 
  mutate(MEASURE_KEY=case_when(
           MEASURE_ID=="MHS30d" ~ "Attended contacts (<18)",
           MEASURE_ID=="CYP01" ~ "People in contact",
           MEASURE_ID=="MHS61a" ~ "First contacts (<18)",
           MEASURE_ID=="CYP23" ~ "Open referrals",
           MEASURE_ID=="MHS32a" ~ "New referrals (<18)",
           TRUE ~ "NA"
         )) %>% 
  select(.,start_date,end_date,month_year,PRIMARY_LEVEL_DESCRIPTION,MEASURE_ID,MEASURE_KEY,MEASURE_VALUE) %>% 
  mutate(.,MEASURE_VALUE=as.numeric(MEASURE_VALUE),
         timing=ifelse(start_date<ymd("2020-04-01"),"Pre-COVID","Post-COVID")) %>%
  mutate(.,timing=fct_relevel(timing, c("Pre-COVID","Post-COVID"))) %>% 
  arrange(.,start_date) %>%
  as_tibble()

#Percentage change compared to a year ago
#For example, for March 2020 show the % change between March 2019 and March 2020

CAMHS_yearly_changes <- CAMHS_data %>%
  select(.,PRIMARY_LEVEL_DESCRIPTION,MEASURE_ID,MEASURE_KEY,MEASURE_VALUE,start_date,month_year,timing) %>%
  mutate(start_date=lubridate::ymd(start_date)) %>%
  mutate(.,start_date_l1=start_date-years(1)) #Adds a new column with the month a year before

#Auxiliary dataset with data points from a year before
CAMHS_data_l1 <- CAMHS_yearly_changes %>%
  select(.,start_date,MEASURE_VALUE,PRIMARY_LEVEL_DESCRIPTION,MEASURE_ID,MEASURE_KEY) %>%
  rename(.,MEASURE_VALUE_l1=MEASURE_VALUE,start_date_l1=start_date)

#Merge auxiliary data back in
CAMHS_yearly_changes <- left_join(CAMHS_yearly_changes,
                                          CAMHS_data_l1,
                                          by=c("start_date_l1","PRIMARY_LEVEL_DESCRIPTION","MEASURE_ID","MEASURE_KEY")) %>%
  arrange(.,MEASURE_ID,start_date) %>%
  mutate(pct_change_l1=(MEASURE_VALUE-MEASURE_VALUE_l1)/MEASURE_VALUE_l1*100) %>%
  filter(.,!is.na(pct_change_l1))
rm(CAMHS_data_l1)

People in contact with CAMHS

Raw time series

#Data
CAMHS_data_cyp01 <- CAMHS_data %>%
  filter(.,MEASURE_ID=="CYP01")
CAMHS_reldata_cyp01 <- CAMHS_yearly_changes %>%
  filter(.,MEASURE_ID=="CYP01")

#Time series chart
CAMHS_raw_chart_cyp01 <- CAMHS_data_cyp01 %>% 
  ggplot(., aes(x=start_date, y=MEASURE_VALUE, group= MEASURE_KEY)) +
  geom_line(aes(color= MEASURE_KEY),
            size=1) +
  scale_x_date(date_labels = "%b %Y",date_breaks = "3 months") +
  scale_y_continuous(labels = scales::comma) +
  facet_wrap(~timing, scales = "free_x") +
  theme_ipsum() +
  xlab("") +
  ylab("") +
  labs(col="") +
  scale_color_brewer(palette = "Set1") +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))
  
ggplotly(CAMHS_raw_chart_cyp01)
#Underlying data
CAMHS_data_cyp01 %>%
  select(.,start_date,MEASURE_KEY,MEASURE_VALUE) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))
start_date MEASURE_KEY MEASURE_VALUE
2018-05-01 People in contact 222,156
2018-06-01 People in contact 225,407
2018-07-01 People in contact 218,557
2018-08-01 People in contact 213,702
2018-09-01 People in contact 218,764
2018-10-01 People in contact 227,845
2018-11-01 People in contact 223,744
2018-12-01 People in contact 227,679
2019-01-01 People in contact 229,217
2019-02-01 People in contact 233,831
2019-03-01 People in contact 241,926
2019-04-01 People in contact 218,678
2019-05-01 People in contact 230,443
2019-06-01 People in contact 225,480
2019-07-01 People in contact 226,647
2019-08-01 People in contact 218,826
2019-09-01 People in contact 221,428
2019-10-01 People in contact 225,507
2019-11-01 People in contact 230,739
2019-12-01 People in contact 231,056
2020-01-01 People in contact 236,396
2020-02-01 People in contact 240,401
2020-03-01 People in contact 237,088
2020-04-01 People in contact 281,199
2020-05-01 People in contact 273,706
2020-06-01 People in contact 272,529
2020-07-01 People in contact 275,439
2020-08-01 People in contact 271,462
2020-09-01 People in contact 286,880
2020-10-01 People in contact 296,414
2020-11-01 People in contact 309,311
2020-12-01 People in contact 311,119
2021-01-01 People in contact 307,335
2021-02-01 People in contact 306,997
2021-03-01 People in contact 317,845
2021-04-01 People in contact 323,240
2021-05-01 People in contact 337,426
2021-06-01 People in contact 340,694
2021-07-01 People in contact 342,565
2021-08-01 People in contact 331,912
2021-09-01 People in contact 337,080

Monthly average, per year

#Average per calendar year
CAMHS_data_cyp01 %>%
  mutate(.,year=lubridate::year(start_date)) %>% 
  group_by(MEASURE_ID,MEASURE_KEY,year) %>%
  summarise(average=mean(MEASURE_VALUE,na.rm = TRUE),
            months_included= n()) %>% 
  ungroup() %>%
  filter(.,months_included==12) %>%
  knitr::kable(., align = "lccrr")
MEASURE_ID MEASURE_KEY year average months_included
CYP01 People in contact 2019 227814.8 12
CYP01 People in contact 2020 274328.7 12

Relative changes compared to last year

#Relative changes chart
CAMHS_changes_chart_cyp01 <- CAMHS_reldata_cyp01 %>%
  ggplot(., aes(x=start_date, y=pct_change_l1, group= MEASURE_KEY)) +
  facet_wrap(~timing, scales = "free_x") +
  geom_line(aes(color= MEASURE_KEY),size=1) +
  geom_hline(yintercept=0, linetype="dashed", color = "red") +
  scale_x_date(date_labels = "%b %Y",date_breaks = "1 month") +
  theme_ipsum() +
  xlab("") +
  ylab("% change") +
  labs(col="") +
  scale_color_manual(values=c("Open referrals" = "aquamarine4",
                              "People in contact" = "tomato3",
                              "First contactsn (<18)" = "olivedrab4",
                              "Attended contacts (<18)" = "violetred",
                              "New referrals (<18)" = "magenta1")) +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))

ggplotly(CAMHS_changes_chart_cyp01)
#Underlying data
CAMHS_reldata_cyp01 %>%
  select(.,start_date,MEASURE_KEY,pct_change_l1) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))
start_date MEASURE_KEY pct_change_l1
2019-05-01 People in contact 3.7302616
2019-06-01 People in contact 0.0323859
2019-07-01 People in contact 3.7015515
2019-08-01 People in contact 2.3977314
2019-09-01 People in contact 1.2177506
2019-10-01 People in contact -1.0261362
2019-11-01 People in contact 3.1263408
2019-12-01 People in contact 1.4832286
2020-01-01 People in contact 3.1319667
2020-02-01 People in contact 2.8097216
2020-03-01 People in contact -1.9997851
2020-04-01 People in contact 28.5904389
2020-05-01 People in contact 18.7738400
2020-06-01 People in contact 20.8661522
2020-07-01 People in contact 21.5277502
2020-08-01 People in contact 24.0538144
2020-09-01 People in contact 29.5590440
2020-10-01 People in contact 31.4433698
2020-11-01 People in contact 34.0523275
2020-12-01 People in contact 34.6509071
2021-01-01 People in contact 30.0085450
2021-02-01 People in contact 27.7020478
2021-03-01 People in contact 34.0620360
2021-04-01 People in contact 14.9506222
2021-05-01 People in contact 23.2804542
2021-06-01 People in contact 25.0120171
2021-07-01 People in contact 24.3705503
2021-08-01 People in contact 22.2683101
2021-09-01 People in contact 17.4986057

New referrals (<18)

Raw time series

#Data
CAMHS_data_cyp32a <- CAMHS_data %>%
  filter(.,MEASURE_ID=="MHS32a")
CAMHS_reldata_cyp32a <- CAMHS_yearly_changes %>%
  filter(.,MEASURE_ID=="MHS32a")

#Time series chart
CAMHS_raw_chart_cyp32a <- CAMHS_data_cyp32a %>% 
  ggplot(., aes(x=start_date, y=MEASURE_VALUE, group= MEASURE_KEY)) +
  geom_line(aes(color= MEASURE_KEY),
            size=1) +
  scale_x_date(date_labels = "%b %Y",date_breaks = "3 months") +
  scale_y_continuous(labels = scales::comma) +
  facet_wrap(~timing, scales = "free_x") +
  theme_ipsum() +
  xlab("") +
  ylab("") +
  labs(col="") +
  scale_color_brewer(palette = "Set1") +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))
  
ggplotly(CAMHS_raw_chart_cyp32a)
#Underlying data
CAMHS_data_cyp32a %>%
  select(.,start_date,MEASURE_KEY,MEASURE_VALUE) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))
start_date MEASURE_KEY MEASURE_VALUE
2019-04-01 New referrals (<18) 64,095
2019-05-01 New referrals (<18) 71,119
2019-06-01 New referrals (<18) 67,449
2019-07-01 New referrals (<18) 71,743
2019-08-01 New referrals (<18) 46,403
2019-09-01 New referrals (<18) 64,284
2019-10-01 New referrals (<18) 83,290
2019-11-01 New referrals (<18) 79,100
2019-12-01 New referrals (<18) 65,547
2020-01-01 New referrals (<18) 84,624
2020-02-01 New referrals (<18) 80,555
2020-03-01 New referrals (<18) 72,532
2020-04-01 New referrals (<18) 41,411
2020-05-01 New referrals (<18) 46,262
2020-06-01 New referrals (<18) 60,370
2020-07-01 New referrals (<18) 67,967
2020-08-01 New referrals (<18) 51,357
2020-09-01 New referrals (<18) 75,222
2020-10-01 New referrals (<18) 88,523
2020-11-01 New referrals (<18) 92,228
2020-12-01 New referrals (<18) 75,841
2021-01-01 New referrals (<18) 68,149
2021-02-01 New referrals (<18) 70,169
2021-03-01 New referrals (<18) 98,112
2021-04-01 New referrals (<18) 85,598
2021-05-01 New referrals (<18) 101,421
2021-06-01 New referrals (<18) 98,037
2021-07-01 New referrals (<18) 85,801
2021-08-01 New referrals (<18) 57,289
2021-09-01 New referrals (<18) 84,264

Monthly average, per year

#Average per calendar year
CAMHS_data_cyp32a %>%
  mutate(.,year=lubridate::year(start_date)) %>% 
  group_by(MEASURE_ID,MEASURE_KEY,year) %>%
  summarise(average=mean(MEASURE_VALUE,na.rm = TRUE),
            months_included= n()) %>% 
  ungroup() %>%
  filter(.,months_included==12) %>%
  knitr::kable(., align = "lccrr")
MEASURE_ID MEASURE_KEY year average months_included
MHS32a New referrals (<18) 2020 69741 12

Relative changes compared to last year

#Relative changes chart
CAMHS_changes_chart_cyp32a <- CAMHS_reldata_cyp32a %>%
  ggplot(., aes(x=start_date, y=pct_change_l1, group= MEASURE_KEY)) +
  facet_wrap(~timing, scales = "free_x") +
  geom_line(aes(color= MEASURE_KEY),size=1) +
  geom_hline(yintercept=0, linetype="dashed", color = "red") +
  scale_x_date(date_labels = "%b %Y",date_breaks = "1 month") +
  theme_ipsum() +
  xlab("") +
  ylab("% change") +
  labs(col="") +
  scale_color_manual(values=c("Open referrals" = "aquamarine4",
                              "People in contact" = "tomato3",
                              "First contacts (<18)" = "olivedrab4",
                              "Attended contacts (<18)" = "violetred",
                              "New referrals (<18)" = "magenta1")) +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))

ggplotly(CAMHS_changes_chart_cyp32a)
#Underlying data
CAMHS_reldata_cyp32a %>%
  select(.,start_date,MEASURE_KEY,pct_change_l1) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))
start_date MEASURE_KEY pct_change_l1
2020-04-01 New referrals (<18) -35.391216
2020-05-01 New referrals (<18) -34.951279
2020-06-01 New referrals (<18) -10.495337
2020-07-01 New referrals (<18) -5.263231
2020-08-01 New referrals (<18) 10.676034
2020-09-01 New referrals (<18) 17.015120
2020-10-01 New referrals (<18) 6.282867
2020-11-01 New referrals (<18) 16.596713
2020-12-01 New referrals (<18) 15.704762
2021-01-01 New referrals (<18) -19.468472
2021-02-01 New referrals (<18) -12.893054
2021-03-01 New referrals (<18) 35.267192
2021-04-01 New referrals (<18) 106.703533
2021-05-01 New referrals (<18) 119.231767
2021-06-01 New referrals (<18) 62.393573
2021-07-01 New referrals (<18) 26.239204
2021-08-01 New referrals (<18) 11.550519
2021-09-01 New referrals (<18) 12.020420

First contacts (<18)

Raw time series

#Data
CAMHS_data_cyp61a <- CAMHS_data %>%
  filter(.,MEASURE_ID=="MHS61a")
CAMHS_reldata_cyp61a <- CAMHS_yearly_changes %>%
  filter(.,MEASURE_ID=="MHS61a")

#Time series chart
CAMHS_raw_chart_cyp61a <- CAMHS_data_cyp61a %>% 
  ggplot(., aes(x=start_date, y=MEASURE_VALUE, group= MEASURE_KEY)) +
  geom_line(aes(color= MEASURE_KEY),
            size=1) +
  scale_x_date(date_labels = "%b %Y",date_breaks = "3 months") +
  scale_y_continuous(labels = scales::comma) +
  facet_wrap(~timing, scales = "free_x") +
  theme_ipsum() +
  xlab("") +
  ylab("") +
  labs(col="") +
  scale_color_brewer(palette = "Set1") +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))
  
ggplotly(CAMHS_raw_chart_cyp61a)
#Underlying data
CAMHS_data_cyp61a %>%
  select(.,start_date,MEASURE_KEY,MEASURE_VALUE) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))
start_date MEASURE_KEY MEASURE_VALUE
2019-04-01 First contacts (<18) 51,694
2019-05-01 First contacts (<18) 49,335
2019-06-01 First contacts (<18) 47,035
2019-07-01 First contacts (<18) 48,293
2019-08-01 First contacts (<18) 36,352
2019-09-01 First contacts (<18) 45,982
2019-10-01 First contacts (<18) 54,568
2019-11-01 First contacts (<18) 54,309
2019-12-01 First contacts (<18) 41,945
2020-01-01 First contacts (<18) 56,823
2020-02-01 First contacts (<18) 52,305
2020-03-01 First contacts (<18) 51,555
2020-04-01 First contacts (<18) 43,246
2020-05-01 First contacts (<18) 38,816
2020-06-01 First contacts (<18) 46,559
2020-07-01 First contacts (<18) 47,685
2020-08-01 First contacts (<18) 39,035
2020-09-01 First contacts (<18) 49,839
2020-10-01 First contacts (<18) 56,951
2020-11-01 First contacts (<18) 60,651
2020-12-01 First contacts (<18) 49,468
2021-01-01 First contacts (<18) 50,832
2021-02-01 First contacts (<18) 48,337
2021-03-01 First contacts (<18) 59,245
2021-04-01 First contacts (<18) 57,734
2021-05-01 First contacts (<18) 62,337
2021-06-01 First contacts (<18) 63,397
2021-07-01 First contacts (<18) 55,473
2021-08-01 First contacts (<18) 43,083
2021-09-01 First contacts (<18) 56,285

Monthly average, per year

#Average per calendar year
CAMHS_data_cyp61a %>%
  mutate(.,year=lubridate::year(start_date)) %>% 
  group_by(MEASURE_ID,MEASURE_KEY,year) %>%
  summarise(average=mean(MEASURE_VALUE,na.rm = TRUE),
            months_included= n()) %>% 
  ungroup() %>%
  filter(.,months_included==12) %>%
  knitr::kable(., align = "lccrr")
MEASURE_ID MEASURE_KEY year average months_included
MHS61a First contacts (<18) 2020 49411.08 12

Relative changes compared to last year

#Relative changes chart
CAMHS_changes_chart_cyp61a <- CAMHS_reldata_cyp61a %>%
  ggplot(., aes(x=start_date, y=pct_change_l1, group= MEASURE_KEY)) +
  facet_wrap(~timing, scales = "free_x") +
  geom_line(aes(color= MEASURE_KEY),size=1) +
  geom_hline(yintercept=0, linetype="dashed", color = "red") +
  scale_x_date(date_labels = "%b %Y",date_breaks = "1 month") +
  theme_ipsum() +
  xlab("") +
  ylab("% change") +
  labs(col="") +
  scale_color_manual(values=c("Open referrals" = "aquamarine4",
                              "People in contact" = "tomato3",
                              "First contacts (<18)" = "olivedrab4",
                              "Attended contacts (<18)" = "violetred",
                              "New referrals (<18)" = "magenta1")) +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))

ggplotly(CAMHS_changes_chart_cyp61a)
#Underlying data
CAMHS_reldata_cyp61a %>%
  select(.,start_date,MEASURE_KEY,pct_change_l1) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))
start_date MEASURE_KEY pct_change_l1
2020-04-01 First contacts (<18) -16.342322
2020-05-01 First contacts (<18) -21.321577
2020-06-01 First contacts (<18) -1.012012
2020-07-01 First contacts (<18) -1.258982
2020-08-01 First contacts (<18) 7.380612
2020-09-01 First contacts (<18) 8.388065
2020-10-01 First contacts (<18) 4.367028
2020-11-01 First contacts (<18) 11.677623
2020-12-01 First contacts (<18) 17.935392
2021-01-01 First contacts (<18) -10.543266
2021-02-01 First contacts (<18) -7.586273
2021-03-01 First contacts (<18) 14.916109
2021-04-01 First contacts (<18) 33.501364
2021-05-01 First contacts (<18) 60.596146
2021-06-01 First contacts (<18) 36.164866
2021-07-01 First contacts (<18) 16.332180
2021-08-01 First contacts (<18) 10.370181
2021-09-01 First contacts (<18) 12.933646

Attended contacts (<18)

Raw time series

#Data
CAMHS_data_cyp30d <- CAMHS_data %>%
  filter(.,MEASURE_ID=="MHS30d")
CAMHS_reldata_cyp30d <- CAMHS_yearly_changes %>%
  filter(.,MEASURE_ID=="MHS30d")

#Time series chart
CAMHS_raw_chart_cyp30d <- CAMHS_data_cyp30d %>% 
  ggplot(., aes(x=start_date, y=MEASURE_VALUE, group= MEASURE_KEY)) +
  geom_line(aes(color= MEASURE_KEY),
            size=1) +
  scale_x_date(date_labels = "%b %Y",date_breaks = "3 months") +
  scale_y_continuous(labels = scales::comma) +
  facet_wrap(~timing, scales = "free_x") +
  theme_ipsum() +
  xlab("") +
  ylab("") +
  labs(col="") +
  scale_color_brewer(palette = "Set1") +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))
  
ggplotly(CAMHS_raw_chart_cyp30d)
#Underlying data
CAMHS_data_cyp30d %>%
  select(.,start_date,MEASURE_KEY,MEASURE_VALUE) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))
start_date MEASURE_KEY MEASURE_VALUE
2019-04-01 Attended contacts (<18) 307,328
2019-05-01 Attended contacts (<18) 346,997
2019-06-01 Attended contacts (<18) 337,476
2019-07-01 Attended contacts (<18) 363,594
2019-08-01 Attended contacts (<18) 274,323
2019-09-01 Attended contacts (<18) 335,775
2019-10-01 Attended contacts (<18) 388,130
2019-11-01 Attended contacts (<18) 383,387
2019-12-01 Attended contacts (<18) 305,574
2020-01-01 Attended contacts (<18) 402,520
2020-02-01 Attended contacts (<18) 361,178
2020-03-01 Attended contacts (<18) 384,011
2020-04-01 Attended contacts (<18) 365,212
2020-05-01 Attended contacts (<18) 360,525
2020-06-01 Attended contacts (<18) 424,827
2020-07-01 Attended contacts (<18) 425,810
2020-08-01 Attended contacts (<18) 336,675
2020-09-01 Attended contacts (<18) 419,474
2020-10-01 Attended contacts (<18) 435,613
2020-11-01 Attended contacts (<18) 473,103
2020-12-01 Attended contacts (<18) 397,443
2021-01-01 Attended contacts (<18) 426,820
2021-02-01 Attended contacts (<18) 412,003
2021-03-01 Attended contacts (<18) 488,234
2021-04-01 Attended contacts (<18) 437,736
2021-05-01 Attended contacts (<18) 463,893
2021-06-01 Attended contacts (<18) 469,830
2021-07-01 Attended contacts (<18) 443,801
2021-08-01 Attended contacts (<18) 350,766
2021-09-01 Attended contacts (<18) 437,555

Monthly average, per year

#Average per calendar year
CAMHS_data_cyp30d %>%
  mutate(.,year=lubridate::year(start_date)) %>% 
  group_by(MEASURE_ID,MEASURE_KEY,year) %>%
  summarise(average=mean(MEASURE_VALUE,na.rm = TRUE),
            months_included= n()) %>% 
  ungroup() %>%
  filter(.,months_included==12) %>%
  knitr::kable(., align = "lccrr")
MEASURE_ID MEASURE_KEY year average months_included
MHS30d Attended contacts (<18) 2020 398865.9 12

Relative changes compared to last year

#Relative changes chart
CAMHS_changes_chart_cyp30d <- CAMHS_reldata_cyp30d %>%
  ggplot(., aes(x=start_date, y=pct_change_l1, group= MEASURE_KEY)) +
  facet_wrap(~timing, scales = "free_x") +
  geom_line(aes(color= MEASURE_KEY),size=1) +
  geom_hline(yintercept=0, linetype="dashed", color = "red") +
  scale_x_date(date_labels = "%b %Y",date_breaks = "1 month") +
  theme_ipsum() +
  xlab("") +
  ylab("% change") +
  labs(col="") +
  scale_color_manual(values=c("Open referrals" = "aquamarine4",
                              "People in contact" = "tomato3",
                              "First contacts (<18)" = "olivedrab4",
                              "Attended contacts (<18)" = "violetred",
                              "New referrals (<18)" = "magenta1")) +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))

ggplotly(CAMHS_changes_chart_cyp30d)
#Underlying data
CAMHS_reldata_cyp30d %>%
  select(.,start_date,MEASURE_KEY,pct_change_l1) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))
start_date MEASURE_KEY pct_change_l1
2020-04-01 Attended contacts (<18) 18.834600
2020-05-01 Attended contacts (<18) 3.898593
2020-06-01 Attended contacts (<18) 25.883618
2020-07-01 Attended contacts (<18) 17.111393
2020-08-01 Attended contacts (<18) 22.729410
2020-09-01 Attended contacts (<18) 24.927109
2020-10-01 Attended contacts (<18) 12.233788
2020-11-01 Attended contacts (<18) 23.400898
2020-12-01 Attended contacts (<18) 30.064403
2021-01-01 Attended contacts (<18) 6.036967
2021-02-01 Attended contacts (<18) 14.072009
2021-03-01 Attended contacts (<18) 27.140629
2021-04-01 Attended contacts (<18) 19.858055
2021-05-01 Attended contacts (<18) 28.671521
2021-06-01 Attended contacts (<18) 10.593253
2021-07-01 Attended contacts (<18) 4.225124
2021-08-01 Attended contacts (<18) 4.185342
2021-09-01 Attended contacts (<18) 4.310398

Open referrals

Raw time series

#Data
CAMHS_data_cyp23 <- CAMHS_data %>%
  filter(.,MEASURE_ID=="CYP23")
CAMHS_reldata_cyp23 <- CAMHS_yearly_changes %>%
  filter(.,MEASURE_ID=="CYP23")

#Time series chart
CAMHS_raw_chart_cyp23 <- CAMHS_data_cyp23 %>% 
  ggplot(., aes(x=start_date, y=MEASURE_VALUE, group= MEASURE_KEY)) +
  geom_line(aes(color= MEASURE_KEY),
            size=1) +
  scale_x_date(date_labels = "%b %Y",date_breaks = "3 months") +
  scale_y_continuous(labels = scales::comma) +
  facet_wrap(~timing, scales = "free_x") +
  theme_ipsum() +
  xlab("") +
  ylab("") +
  labs(col="") +
  scale_color_brewer(palette = "Set1") +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))
  
ggplotly(CAMHS_raw_chart_cyp23)
#Underlying data
CAMHS_data_cyp23 %>%
  select(.,start_date,MEASURE_KEY,MEASURE_VALUE) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))
start_date MEASURE_KEY MEASURE_VALUE
2018-05-01 Open referrals 247,499
2018-06-01 Open referrals 251,573
2018-07-01 Open referrals 243,916
2018-08-01 Open referrals 238,803
2018-09-01 Open referrals 245,003
2018-10-01 Open referrals 255,855
2018-11-01 Open referrals 252,726
2018-12-01 Open referrals 256,644
2019-01-01 Open referrals 258,525
2019-02-01 Open referrals 264,305
2019-03-01 Open referrals 272,605
2019-04-01 Open referrals 248,038
2019-05-01 Open referrals 260,485
2019-06-01 Open referrals 255,950
2019-07-01 Open referrals 257,152
2019-08-01 Open referrals 248,313
2019-09-01 Open referrals 251,483
2019-10-01 Open referrals 256,252
2019-11-01 Open referrals 262,299
2019-12-01 Open referrals 261,939
2020-01-01 Open referrals 268,184
2020-02-01 Open referrals 272,482
2020-03-01 Open referrals 267,871
2020-04-01 Open referrals 307,837
2020-05-01 Open referrals 302,241
2020-06-01 Open referrals 301,012
2020-07-01 Open referrals 304,491
2020-08-01 Open referrals 300,469
2020-09-01 Open referrals 318,375
2020-10-01 Open referrals 329,392
2020-11-01 Open referrals 344,178
2020-12-01 Open referrals 345,569
2021-01-01 Open referrals 340,421
2021-02-01 Open referrals 340,218
2021-03-01 Open referrals 352,551
2021-04-01 Open referrals 358,282
2021-05-01 Open referrals 374,401
2021-06-01 Open referrals 379,079
2021-07-01 Open referrals 380,738
2021-08-01 Open referrals 368,610
2021-09-01 Open referrals 374,946

Monthly average, per year

#Average per calendar year
CAMHS_data_cyp23 %>%
  mutate(.,year=lubridate::year(start_date)) %>% 
  group_by(MEASURE_ID,MEASURE_KEY,year) %>%
  summarise(average=mean(MEASURE_VALUE,na.rm = TRUE),
            months_included= n()) %>% 
  ungroup() %>%
  filter(.,months_included==12) %>%
  knitr::kable(., align = "lccrr")
MEASURE_ID MEASURE_KEY year average months_included
CYP23 Open referrals 2019 258112.2 12
CYP23 Open referrals 2020 305175.1 12

Relative changes compared to last year

#Relative changes chart
CAMHS_changes_chart_cyp23 <- CAMHS_reldata_cyp23 %>%
  ggplot(., aes(x=start_date, y=pct_change_l1, group= MEASURE_KEY)) +
  facet_wrap(~timing, scales = "free_x") +
  geom_line(aes(color= MEASURE_KEY),size=1) +
  geom_hline(yintercept=0, linetype="dashed", color = "red") +
  scale_x_date(date_labels = "%b %Y",date_breaks = "1 month") +
  theme_ipsum() +
  xlab("") +
  ylab("% change") +
  labs(col="") +
  scale_color_manual(values=c("Open referrals" = "aquamarine4",
                              "People in contact" = "tomato3",
                              "First contacts (<18)" = "olivedrab4",
                              "Attended contacts (<18)" = "violetred",
                              "New referrals (<18)" = "magenta1")) +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))

ggplotly(CAMHS_changes_chart_cyp23)
#Underlying data
CAMHS_reldata_cyp23 %>%
  select(.,start_date,MEASURE_KEY,pct_change_l1) %>%
  arrange(.,start_date) %>% 
  knitr::kable(., align = "lccrr",format.args = list(big.mark = ","))
start_date MEASURE_KEY pct_change_l1
2019-05-01 Open referrals 5.246890
2019-06-01 Open referrals 1.739853
2019-07-01 Open referrals 5.426458
2019-08-01 Open referrals 3.982362
2019-09-01 Open referrals 2.644866
2019-10-01 Open referrals 0.155166
2019-11-01 Open referrals 3.787897
2019-12-01 Open referrals 2.063169
2020-01-01 Open referrals 3.736196
2020-02-01 Open referrals 3.093774
2020-03-01 Open referrals -1.736579
2020-04-01 Open referrals 24.108806
2020-05-01 Open referrals 16.030098
2020-06-01 Open referrals 17.605782
2020-07-01 Open referrals 18.408957
2020-08-01 Open referrals 21.004136
2020-09-01 Open referrals 26.599015
2020-10-01 Open referrals 28.542216
2020-11-01 Open referrals 31.215902
2020-12-01 Open referrals 31.927281
2021-01-01 Open referrals 26.935611
2021-02-01 Open referrals 24.858890
2021-03-01 Open referrals 31.612231
2021-04-01 Open referrals 16.386919
2021-05-01 Open referrals 23.874987
2021-06-01 Open referrals 25.934846
2021-07-01 Open referrals 25.040806
2021-08-01 Open referrals 22.678213
2021-09-01 Open referrals 17.768669

People with eating disorders being seen within target times (<18)

#Eating disorders data
target_time_ed_data_new <- MHSDS_main_pooled_dashboard %>%
  filter(.,PRIMARY_LEVEL_DESCRIPTION=="England",
         MEASURE_ID %in% c("ED86e","ED87e")) %>%
  select(.,start_date,end_date,PRIMARY_LEVEL_DESCRIPTION,MEASURE_ID,MEASURE_VALUE)

target_time_ed_data <- MHSDS_ED_pooled_dashboard %>%
  filter(.,PRIMARY_LEVEL_DESCRIPTION=="England",
         MEASURE_ID %in% c("ED86e","ED87e")) %>%
  select(.,start_date,end_date,PRIMARY_LEVEL_DESCRIPTION,MEASURE_ID,MEASURE_VALUE) %>%
  plyr::rbind.fill(.,target_time_ed_data_new) %>% 
  mutate(.,timing=ifelse(end_date<ymd("2020-04-01"),"Pre-COVID","Post-COVID")) %>%
  mutate(.,timing=fct_relevel(timing, c("Pre-COVID","Post-COVID"))) %>%
  mutate(.,MEASURE_VALUE=as.numeric(MEASURE_VALUE),
         Type=case_when(MEASURE_ID=="ED86e" ~ "urgent",
                        MEASURE_ID=="ED87e" ~ "non urgent",
                        TRUE ~ "NA"))

#Eating disorders chart
target_time_ed_chart <- target_time_ed_data %>%
  ggplot(., aes(x=end_date, y=MEASURE_VALUE, group=Type)) +
  geom_line(aes(color=Type),size=1) +
  scale_x_date(date_labels = "%b %Y",date_breaks = "1 month") +
  scale_y_continuous(labels = scales::comma) +
  facet_wrap(~timing, scales = "free_x") +
  theme_ipsum() +
  xlab("") +
  ylab("") +
  labs(col="", title="") +
  scale_colour_manual(values=
                        c("urgent" = "brown", "non urgent" = "darkseagreen4")) +
  theme(legend.position="bottom",
        panel.border = element_blank(),
        strip.text = element_text(size=8),
        text = element_text(size = 8),
        legend.title=element_text(size=8),
        legend.text=element_text(size=8),
        axis.text = element_text(size = 8),
        axis.text.y = element_text(size = 8),
        axis.text.x = element_text(angle = 45, hjust = 1,size = 8),
        axis.title.x = element_text(margin = unit(c(3, 0, 0, 0), "mm"),size = 8),
        axis.title.y = element_text(size = 8))

ggplotly(target_time_ed_chart)

Health Education England data on workforce (compared to activity levels from NHS England)

#NHS Digital on people in contact with CAMHS service
CAMHS_contacts <- MHSDS_main_pooled_dashboard %>%
  filter(.,PRIMARY_LEVEL_DESCRIPTION=="England",
         MEASURE_ID=="CYP01") %>%
  select(.,start_date,MEASURE_VALUE) %>%
  mutate(.,date_ymd=lubridate::ymd(start_date)) %>%
  mutate(.,date_ymd=floor_date(date_ymd, "month"),
         measure="People in contact CAMHS",
         MEASURE_VALUE=as.numeric(MEASURE_VALUE)) %>%
  select(.,-"start_date") %>%
  arrange(.,date_ymd)

#Turn into indexed data
CAMHS_contacts_index <- CAMHS_contacts %>%
  mutate(.,MEASURE_VALUE_MA=zoo::rollmean(MEASURE_VALUE,k=7,fill=NA)) %>% #Use a moving average to compute the mean
  mutate(.,Jan2019=filter(.,date_ymd=="2019-01-01")$MEASURE_VALUE_MA) %>%
  filter(.,date_ymd>=ymd("2019-01-01"),!is.na(MEASURE_VALUE_MA)) %>%
  mutate(.,index=MEASURE_VALUE_MA/Jan2019*100)

#HEE data (copied over from report)
HEE_staff_index <- data.frame(measure="CYP MH staff",
  date_ymd=as.Date(c("2019-01-01","2021-04-01")),
  MEASURE_VALUE=as.numeric(c("14857","20626"))) %>%
  mutate(.,Jan2019=filter(.,date_ymd=="2019-01-01")$MEASURE_VALUE) %>%
  mutate(.,index=MEASURE_VALUE/Jan2019*100)

#Append two sources together
CAMHS_and_HEE_staff <- plyr::rbind.fill(CAMHS_contacts_index,HEE_staff_index)

#Show data
CAMHS_and_HEE_staff %>%
  knitr::kable(., align = "lccrr")
MEASURE_VALUE date_ymd measure MEASURE_VALUE_MA Jan2019 index
229217 2019-01-01 People in contact CAMHS 228988.6 228988.6 100.00000
233831 2019-02-01 People in contact CAMHS 229359.7 228988.6 100.16208
241926 2019-03-01 People in contact CAMHS 229607.7 228988.6 100.27038
218678 2019-04-01 People in contact CAMHS 229460.3 228988.6 100.20600
230443 2019-05-01 People in contact CAMHS 227975.9 228988.6 99.55774
225480 2019-06-01 People in contact CAMHS 226204.0 228988.6 98.78397
226647 2019-07-01 People in contact CAMHS 223858.4 228988.6 97.75965
218826 2019-08-01 People in contact CAMHS 225581.4 228988.6 98.51209
221428 2019-09-01 People in contact CAMHS 225669.0 228988.6 98.55033
225507 2019-10-01 People in contact CAMHS 227228.4 228988.6 99.23134
230739 2019-11-01 People in contact CAMHS 229193.3 228988.6 100.08940
231056 2019-12-01 People in contact CAMHS 231802.1 228988.6 101.22870
236396 2020-01-01 People in contact CAMHS 240340.9 228988.6 104.95758
240401 2020-02-01 People in contact CAMHS 247226.4 228988.6 107.96453
237088 2020-03-01 People in contact CAMHS 253196.4 228988.6 110.57164
281199 2020-04-01 People in contact CAMHS 259536.9 228988.6 113.34053
273706 2020-05-01 People in contact CAMHS 264546.3 228988.6 115.52816
272529 2020-06-01 People in contact CAMHS 271186.1 228988.6 118.42781
275439 2020-07-01 People in contact CAMHS 279661.3 228988.6 122.12893
271462 2020-08-01 People in contact CAMHS 283677.3 228988.6 123.88273
286880 2020-09-01 People in contact CAMHS 289022.0 228988.6 126.21678
296414 2020-10-01 People in contact CAMHS 293994.3 228988.6 128.38819
309311 2020-11-01 People in contact CAMHS 298502.6 228988.6 130.35697
311119 2020-12-01 People in contact CAMHS 305128.7 228988.6 133.25063
307335 2021-01-01 People in contact CAMHS 310323.0 228988.6 135.51899
306997 2021-02-01 People in contact CAMHS 316181.9 228988.6 138.07757
317845 2021-03-01 People in contact CAMHS 320665.1 228988.6 140.03544
323240 2021-04-01 People in contact CAMHS 325157.4 228988.6 141.99723
337426 2021-05-01 People in contact CAMHS 328668.4 228988.6 143.53049
340694 2021-06-01 People in contact CAMHS 332966.0 228988.6 145.40726
14857 2019-01-01 CYP MH staff NA 14857.0 100.00000
20626 2021-04-01 CYP MH staff NA 14857.0 138.83018

NHS England data on workforce (child and adolescent psychiatry only)

#NHS data
NHS_workforce_doctors %>%
  mutate(.,date_ymd=lubridate::ymd(Date)) %>%
  mutate(.,date_ymd=floor_date(date_ymd, "month"),
         measure="FTE doctors") %>%
  rename(.,MEASURE_VALUE=FTE) %>%
  filter(Specialty %in% c("Child and adolescent psychiatry")) %>%
  group_by(date_ymd,measure,Specialty) %>%
  summarise(MEASURE_VALUE=sum(MEASURE_VALUE,na.rm=TRUE)) %>% #Aggregate over categories
  ungroup() %>%
  filter(., date_ymd %in% c(ymd("2019-01-01"),ymd("2021-04-01"))) %>%
  pivot_wider(
    names_from = date_ymd,
    names_sep = ".",
    values_from = MEASURE_VALUE
  ) %>%
  mutate(.,pct_change=(`2021-04-01`-`2019-01-01`)/`2019-01-01`*100) %>%
  knitr::kable(., align = "lccrr")
measure Specialty 2019-01-01 2021-04-01 pct_change
FTE doctors Child and adolescent psychiatry 981.6823 1064.256 8.411452
#Latest data on consultants
NHS_workforce_doctors %>%
  mutate(.,date_ymd=lubridate::ymd(Date)) %>%
  mutate(.,date_ymd=floor_date(date_ymd, "month"),
         measure="FTE doctors") %>%
  rename(.,MEASURE_VALUE=FTE) %>%
  filter(., date_ymd %in% c(ymd("2021-05-01"))) %>%
  filter(Specialty %in% c("Child and adolescent psychiatry"))  %>%
  select(.,-"Date") %>% 
  knitr::kable(., align = "lccrr")
Grade Grade Order Code Specialty Group Specialty MEASURE_VALUE date_ymd measure
Consultant 1 Psychiatry group Child and adolescent psychiatry 626.5470 2021-05-01 FTE doctors
Associate Specialist 2 Psychiatry group Child and adolescent psychiatry 13.3725 2021-05-01 FTE doctors
Specialty Doctor 3 Psychiatry group Child and adolescent psychiatry 100.9210 2021-05-01 FTE doctors
Staff Grade 4 Psychiatry group Child and adolescent psychiatry 3.5000 2021-05-01 FTE doctors
Specialty Registrar 5 Psychiatry group Child and adolescent psychiatry 144.8688 2021-05-01 FTE doctors
Core Training 6 Psychiatry group Child and adolescent psychiatry 142.1062 2021-05-01 FTE doctors
Foundation Doctor Year 2 7 Psychiatry group Child and adolescent psychiatry 10.0000 2021-05-01 FTE doctors
Foundation Doctor Year 1 8 Psychiatry group Child and adolescent psychiatry 10.0000 2021-05-01 FTE doctors